delphi 串口通信程序源码

【例子介绍】

  本程序完全参照龚建伟《串口调试助手V2.2》制作而成，原软件是用VC编写的，现用Delphi编写，可作为学习串口编程的一个例子与工具使用。

   其中用到串口控件为ComPort，该控件为开源软件，各大网站均有下载，目前最新版为3.0。

【相关图片】

【源码结构】

{*****************************************************************
*串口调试助手V1.0
*作    者：sky
*Email   : mastersky@21cn.com
*QQ      : 11116580
*版    本：V1.0
*编写时间：2005/12/19
*说    明：本程序完全参照龚建伟VC版《串口调试助手V2.2》编写而成。
           仅供学习测试之用。
******************************************************************}

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, Spin, ExtCtrls, ImgList, CPort, CPortCtl,ShellApi,
  FileCtrl;

type
  TFrmMain = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Memo1: TMemo;
    cbsendHex: TCheckBox;
    cbAutoSend: TCheckBox;
    Label1: TLabel;
    SpinEdit1: TSpinEdit;
    Label2: TLabel;
    Button1: TButton;
    Panel4: TPanel;
    btnSend: TButton;
    Button3: TButton;
    Button4: TButton;
    edSendFile: TEdit;
    SpeedButton1: TSpeedButton;
    Memo2: TMemo;
    edStatus: TEdit;
    edRx: TEdit;
    edTx: TEdit;
    Button5: TButton;
    ImageList1: TImageList;
    BitBtn1: TBitBtn;
    GroupBox1: TGroupBox;
    ComComboBox1: TComComboBox;
    ComComboBox2: TComComboBox;
    ComComboBox3: TComComboBox;
    ComComboBox4: TComComboBox;
    ComComboBox5: TComComboBox;
    ComComboBox6: TComComboBox;
    ComPort: TComPort;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    ComLed1: TComLed;
    Label9: TLabel;
    ComLed2: TComLed;
    Label10: TLabel;
    ComLed3: TComLed;
    Label11: TLabel;
    btnSwitch: TButton;
    Panel5: TPanel;
    Button6: TButton;
    cbRecHex: TCheckBox;
    cbAutoClean: TCheckBox;
    btnStopShow: TButton;
    Button8: TButton;
    Button9: TButton;
    edPath: TEdit;
    BitBtn2: TBitBtn;
    Timer1: TTimer;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure SpeedButton1Click(Sender: TObject);
    procedure ComPortAfterOpen(Sender: TObject);
    procedure ComPortAfterClose(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure btnSwitchClick(Sender: TObject);
    procedure Label12Click(Sender: TObject);
    procedure Label13Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ComComboBox1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure cbAutoSendClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnStopShowClick(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure ComPortRxChar(Sender: TObject; Count: Integer);
    procedure BitBtn2Click(Sender: TObject);
  private
    FShowText:Boolean;
    FRXNum:Integer;
    FTXNum:Integer;
    TmpStr:String;
    procedure ShowRX;
    procedure ShowTX;
    procedure ShowStatus;
    procedure SendFile(const filename:string);
    procedure SendString(const str:string);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

const
  CWidth=713;
  CHeight=470;

{$R *.dfm}

procedure TFrmMain.SpeedButton1Click(Sender: TObject);
var
  B:TBitmap;
begin
  B:=TBitmap.Create;
  if Self.FormStyle=fsNormal then
  begin
    Self.FormStyle:=fsStayOnTop;
    SpeedButton1.Down:=True;

    if ImageList1.GetBitmap(1,B) then
    begin
      SpeedButton1.Glyph.Assign(B);
    end;
  end
  else if Self.FormStyle=fsStayOnTop then
  begin
    Self.FormStyle:=fsNormal;
    SpeedButton1.Down:=False;
    if ImageList1.GetBitmap(0,B) then
    begin
      SpeedButton1.Glyph.Assign(B);
    end;
  end;
  B.Free;
end;

procedure TFrmMain.ComPortAfterOpen(Sender: TObject);
begin
  btnSwitch.Caption:='关闭串口';
  ShowStatus;
end;

procedure TFrmMain.ComPortAfterClose(Sender: TObject);
begin
  btnSwitch.Caption:='打开串口';
  ShowStatus;
end;

procedure TFrmMain.FormResize(Sender: TObject);
begin
  if Height<CHeight then
    Height:=CHeight;
  if Width<CWidth then
    Width:=CWidth;
end;

procedure TFrmMain.btnSwitchClick(Sender: TObject);
begin
  if ComPort.Connected then
    ComPort.Close
  else ComPort.Open;
end;

procedure TFrmMain.Label12Click(Sender: TObject);
begin
  ShellExecute(0,'open','mailto: mastersky@21cn.com?subject=串口调试助手Delphi版',
               NIL, NIL, SW_SHOWNORMAL);
end;

procedure TFrmMain.Label13Click(Sender: TObject);
begin
  ShellExecute(0,'open','http://www.delphipages.cn',
               NIL, NIL, SW_SHOWNORMAL);
end;

procedure TFrmMain.BitBtn1Click(Sender: TObject);
begin
  Close;
end;

procedure TFrmMain.Button6Click(Sender: TObject);
begin
  Memo1.Clear;
  if ComPort.Connected then
    ComPort.ClearBuffer(True,False);
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  FShowText:=True;
  FRXNum:=0;
  FTXNum:=0;
end;

procedure TFrmMain.ShowRX;
begin
  edRX.Text:='Rx:' IntTostr(FRXNum);
end;

procedure TFrmMain.ShowStatus;
begin
  if ComPort.Connected then
  begin
    edStatus.Text:=Format('STATUS:%s Opend %s %s %s %s %s',[ComComboBox1.Text,
      ComComboBox2.Text,ComComboBox3.Text,ComComboBox4.Text,ComComboBox5.Text,
      ComComboBox6.Text]);
  end
  else edStatus.Text:='STATUS:COM Port Closed';
end;

procedure TFrmMain.ShowTX;
begin
  edTx.Text:='Tx:' IntTostr(FTXNum);
end;

procedure TFrmMain.Button5Click(Sender: TObject);
begin
  FRXNum:=0;
  FTXNum:=0;
  ShowRX;
  ShowTX;
end;

procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ComPort.OnAfterClose:=nil;
end;

procedure TFrmMain.ComComboBox1Change(Sender: TObject);
begin
  ShowStatus;
end;

procedure TFrmMain.Button1Click(Sender: TObject);
begin
  Memo2.Clear;
end;

procedure TFrmMain.SpinEdit1Change(Sender: TObject);
begin
  Timer1.Interval:=SpinEdit1.Value;
end;

procedure TFrmMain.cbAutoSendClick(Sender: TObject);
begin
  Timer1.Enabled:=cbAutoSend.Checked;
end;

procedure TFrmMain.Timer1Timer(Sender: TObject);
begin
  if Memo2.Text<>'' then
    btnSend.Click;
end;

procedure TFrmMain.btnStopShowClick(Sender: TObject);
begin
  FShowText:=not FShowText;
  if FShowText then
    btnStopShow.Caption:='停止显示'
  else btnStopShow.Caption:='继续显示';
end;

procedure TFrmMain.Button9Click(Sender: TObject);
var
  Dir: string;
begin
  Dir := edPath.Text;
  if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then
    edPath.Text := Dir;
end;

function AddBackSlash(const S: string): string;
begin
  Result := S;
  if S<>'' then
  begin
    if Result[Length(Result)] <> '\' then
      Result := Result   '\';              
  end;
end;

procedure TFrmMain.Button8Click(Sender: TObject);
var
  S:string;
begin
  S:=AddBackSlash(edPath.Text);
  if not DirectoryExists(S) then
    CreateDir(S);
  S:=S 'Rec' FormatDateTime('yymmddhhssnn',Now) '.txt';
  Memo1.Lines.SaveToFile(S);
  ShowMessage(S '已保存');
end;

procedure TFrmMain.Button3Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    edSendFile.Text:=OpenDialog1.FileName;
end;

procedure TFrmMain.Button4Click(Sender: TObject);
begin
  if FileExists(edSendFile.Text) then
    SendFile(edSendFile.Text);
end;

procedure TFrmMain.SendFile(const filename: string);
var
  S:TStringList;
begin
  S:=TStringList.Create;
  try
    S.LoadFromFile(filename);
    SendString(S.Text);
  finally
    S.Free;
  end;
end;

function HexStrToStr(const S:string):string;
//16进制字符串转换成字符串
var
  t:Integer;
  ts:string;
  M,Code:Integer;
begin
  t:=1;
  Result:='';
  while t<=Length(S) do
  begin
    while not (S[t] in ['0'..'9','A'..'F','a'..'f']) do
      inc(t);
    if (t 1>Length(S))or(not (S[t 1] in ['0'..'9','A'..'F','a'..'f'])) then
      ts:='$' S[t]
    else
      ts:='$' S[t] S[t 1];
    Val(ts,M,Code);
    if Code=0 then
      Result:=Result Chr(M);
    inc(t,2);
  end;
end;

procedure TFrmMain.btnSendClick(Sender: TObject);
begin
  if cbsendHex.Checked then
    SendString(HexStrToStr(Memo2.Text))
  else
    SendString(Memo2.Text);
end;

procedure TFrmMain.SendString(const str: string);
var
  obj:PAsync;
begin
  InitAsync(obj);
  try
    ComPort.WriteStrAsync(str,obj);
    ComPort.WaitForAsync(obj);
    FTXNum:=FTXNum Length(str);
  finally
    DoneAsync(obj);
    ShowTX;
  end;
end;

function StrToHexStr(const S:string):string;
//字符串转换成16进制字符串
var
  I:Integer;
begin
  for I:=1 to Length(S) do
  begin
    if I=1 then
      Result:=IntToHex(Ord(S[1]),2)
    else Result:=Result ' ' IntToHex(Ord(S[I]),2);
  end;
end;

procedure TFrmMain.ComPortRxChar(Sender: TObject; Count: Integer);
var
  Str: String;
begin
  ComPort.ReadStr(Str, Count);
  if FShowText then
  begin
    if cbRecHex.Checked then
      Memo1.Text:=Memo1.Text StrToHexStr(Str)
    else
      Memo1.Text := Memo1.Text   Str;
  end;
  TmpStr:=TmpStr Str;
  FRXNum:=FRXNum Count;
  showmessage(inttostr(FRXNum));
  ShowRX;
end;

procedure TFrmMain.BitBtn2Click(Sender: TObject);
begin
  ShellExecute(0,'open',PChar(ExtractFilePath(Application.ExeName) 'help.htm'),
               NIL, NIL, SW_SHOWNORMAL);
end;

end.